home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
IQ_TEST
/
BARONA.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-08-03
|
13KB
|
502 lines
Program basicmenu;
{$R basicmnu.res}
{$R Wais.res}
uses wintypes, winprocs, wobjects, sfx200, wincrt;
const
id_item1=101;
id_item2=102;
id_item4=104;
id_help=200;
id_listbox1=800;
id_listbox2=801;
id_listbox3=802;
helpcreate=1;
helpuse=2;
var
fsiq,psiq,vsiq:real;
type tmenuapp=object(tapplication)
procedure initmainwindow;virtual;
end;
pmainwin=^tmainwin;
tmainwin=object(tsfxwindow)
cmhelp:boolean;
constructor init (aparent:pwindowsobject;atitle:pchar);
procedure help (var msg:tmessage);virtual cm_first + id_help;
procedure item1 (var msg:tmessage); virtual cm_first + id_item1;
procedure item2 (var msg:tmessage); virtual cm_first + id_item2;
procedure item4 (var msg:tmessage); virtual cm_first + id_item4;
end;
pinfodlg = ^tsfxdialog;
tsfxdialog = object(tdialog)
constructor init (aparent:pwindowsobject; aname:pchar;buffer:pchar);
procedure setupwindow;virtual;
procedure ok (var msg:tmessage);virtual id_first + id_ok;
end;
pgenderdlg = ^tgenderdlg;
tgenderdlg = object(tdialog)
constructor init (aparent:pwindowsobject; atitle:pchar);
procedure ok (var msg:tmessage);virtual id_first + id_ok;
end;
pagedlg = ^tagedlg;
tagedlg = object(tdialog)
constructor init (aparent:pwindowsobject; atitle:pchar);
procedure ok (var msg:tmessage);virtual id_first + id_ok;
end;
pracedlg = ^tracedlg;
tracedlg = object(tdialog)
constructor init (aparent:pwindowsobject; atitle:pchar);
procedure ok (var msg:tmessage);virtual id_first + id_ok;
end;
peducdlg = ^teducdlg;
teducdlg = object(tdialog)
constructor init (aparent:pwindowsobject; atitle:pchar);
procedure ok (var msg:tmessage);virtual id_first + id_ok;
end;
pworkdlg = ^tworkdlg;
tworkdlg = object(tdialog)
constructor init (aparent:pwindowsobject; atitle:pchar);
procedure ok (var msg:tmessage);virtual id_first + id_ok;
end;
pregiondlg = ^tregiondlg;
tregiondlg = object(tdialog)
constructor init (aparent:pwindowsobject; atitle:pchar);
procedure ok (var msg:tmessage);virtual id_first + id_ok;
end;
presdlg = ^tresdlg;
tresdlg = object(tdialog)
constructor init (aparent:pwindowsobject; atitle:pchar);
procedure ok (var msg:tmessage);virtual id_first + id_ok;
end;
piqdlg = ^tiqdlg;
tiqdlg = object(tdialog)
listbox1:plistbox;
listbox2:plistbox;
listbox3:plistbox;
constructor init (aparent:pwindowsobject; atitle:pchar);
procedure setupwindow;virtual;
procedure ok (var msg:tmessage);virtual id_first + id_ok;
end;
pwarndlg = ^twarndlg;
twarndlg = object(tdialog)
constructor init (aparent:pwindowsobject; atitle:pchar);
procedure ok (var msg:tmessage);virtual id_first + id_ok;
end;
{******************* ABOUT DIALOG *************************************}
constructor tsfxdialog.init (aparent:pwindowsobject; aname:pchar;buffer:pchar);
begin
attr.param:=mws_raised3dFrame;
tdialog.init(aparent,aname);
end;
procedure tsfxdialog.setupwindow;
begin
attr.param:=mws_raised3dframe;
tdialog.setupwindow;
end;
procedure tsfxdialog.ok (var msg:tmessage);
begin
tdialog.ok(msg);
end;
constructor tgenderdlg.init (aparent:pwindowsobject; atitle:pchar);
var
btn:pradiobutton;
begin
attr.param:=mws_raised3dFrame;
tdialog.init(aparent,atitle);
new(btn,initresource(@self,200));
new(btn,initresource(@self,201));
end;
procedure tgenderdlg.ok (var msg:tmessage);
begin
tdialog.ok(msg);
end;
constructor tagedlg.init (aparent:pwindowsobject; atitle:pchar);
var
btn:pradiobutton;
begin
attr.param:=mws_raised3dFrame;
tdialog.init(aparent,atitle);
new(btn,initresource(@self,203));
new(btn,initresource(@self,204));
new(btn,initresource(@self,205));
new(btn,initresource(@self,206));
new(btn,initresource(@self,207));
new(btn,initresource(@self,208));
new(btn,initresource(@self,209));
new(btn,initresource(@self,210));
new(btn,initresource(@self,211));
end;
procedure tagedlg.ok (var msg:tmessage);
begin
tdialog.ok(msg);
end;
constructor tracedlg.init (aparent:pwindowsobject; atitle:pchar);
var
btn:pradiobutton;
begin
attr.param:=mws_raised3dFrame;
tdialog.init(aparent,atitle);
new(btn,initresource(@self,212));
new(btn,initresource(@self,213));
new(btn,initresource(@self,214));
end;
procedure tracedlg.ok (var msg:tmessage);
begin
tdialog.ok(msg);
end;
constructor teducdlg.init (aparent:pwindowsobject; atitle:pchar);
var
btn:pradiobutton;
begin
attr.param:=mws_raised3dFrame;
tdialog.init(aparent,atitle);
new(btn,initresource(@self,101));
new(btn,initresource(@self,102));
new(btn,initresource(@self,103));
new(btn,initresource(@self,104));
new(btn,initresource(@self,105));
new(btn,initresource(@self,106));
end;
procedure teducdlg.ok (var msg:tmessage);
begin
tdialog.ok(msg);
end;
constructor tworkdlg.init (aparent:pwindowsobject; atitle:pchar);
var
btn:pradiobutton;
begin
attr.param:=mws_raised3dFrame;
tdialog.init(aparent,atitle);
new(btn,initresource(@self,101));
new(btn,initresource(@self,102));
new(btn,initresource(@self,103));
new(btn,initresource(@self,104));
new(btn,initresource(@self,105));
new(btn,initresource(@self,106));
end;
procedure tworkdlg.ok (var msg:tmessage);
begin
tdialog.ok(msg);
end;
constructor tregiondlg.init (aparent:pwindowsobject; atitle:pchar);
var
btn:pradiobutton;
begin
attr.param:=mws_raised3dFrame;
tdialog.init(aparent,atitle);
new(btn,initresource(@self,101));
new(btn,initresource(@self,102));
new(btn,initresource(@self,103));
new(btn,initresource(@self,104));
end;
procedure tregiondlg.ok (var msg:tmessage);
begin
tdialog.ok(msg);
end;
constructor tresdlg.init (aparent:pwindowsobject; atitle:pchar);
var
btn:pradiobutton;
begin
attr.param:=mws_raised3dFrame;
tdialog.init(aparent,atitle);
new(btn,initresource(@self,101));
new(btn,initresource(@self,102));
end;
procedure tresdlg.ok (var msg:tmessage);
begin
tdialog.ok(msg);
end;
constructor tiqdlg.init (aparent:pwindowsobject; atitle:pchar);
begin
attr.param:=mws_raised3dFrame;
tdialog.init(aparent,atitle);
listbox1:=new(plistbox,initresource(@self,id_listbox1));
listbox2:=new(plistbox,initresource(@self,id_listbox2));
listbox3:=new(plistbox,initresource(@self,id_listbox3));
end;
procedure tiqdlg.setupwindow;
var
full:string;
perf:string;
verb:string;
myfull:string;
myverb:string;
myperf:string;
begin
tdialog.setupwindow;
STR(psiq:3:0,perf);
myperf:=perf;
perf:=' '+myperf+' ';
STR(fsiq:3:0,full);
myfull:=full;
full:=' '+myfull+' ';
STR(vsiq:3:0,verb);
myverb:=verb;
verb:=' '+myverb+' ';
listbox1^.addstring (@verb[1]);
listbox2^.addstring (@perf[1]);
listbox3^.addstring (@full[1]);
end;
procedure tiqdlg.ok (var msg:tmessage);
begin
tdialog.ok(msg);
end;
constructor twarndlg.init (aparent:pwindowsobject; atitle:pchar);
begin
attr.param:=mws_raised3dFrame;
tdialog.init(aparent,atitle);
end;
procedure twarndlg.ok (var msg:tmessage);
begin
tdialog.ok(msg);
end;
{********************** Data Collecting Dialogs *****************************}
{******************* MENU ITEM PROCEDURES ****************************}
procedure tmainwin.item1 (var msg:tmessage);
var
dlg1:pgenderdlg;
dlg2:pagedlg;
dlg3:pracedlg;
dlg4:peducdlg;
dlg5:pworkdlg;
dlg6:pregiondlg;
dlg7:presdlg;
dlg99:piqdlg;
dlg100:pwarndlg;
btns:array[0..8]of word;
gender,age,race,educ,work,region,res,x:integer;
begin
new(dlg1,init(@self,pchar('DIALOG_1')));
dlg1^.transferbuffer:=@btns;
application^.execdialog(dlg1);
if btns[0]=1 then gender:=2 else
if btns[1]=1 then gender:=1 else
gender:=0;
for x:=0 to 8 do
btns[x]:=0;
new(dlg2,init(@self,pchar('DIALOG_2')));
dlg2^.transferbuffer:=@btns;
application^.execdialog(dlg2);
if btns[0]=1 then age:=1 else
if btns[1]=1 then age:=2 else
if btns[2]=1 then age:=3 else
if btns[3]=1 then age:=4 else
if btns[4]=1 then age:=5 else
if btns[5]=1 then age:=6 else
if btns[6]=1 then age:=7 else
if btns[7]=1 then age:=8 else
if btns[8]=1 then age:=9 else
age:=0;
for x:=0 to 8 do
btns[x]:=0;
new(dlg3,init(@self,pchar('DIALOG_3')));
dlg3^.transferbuffer:=@btns;
application^.execdialog(dlg3);
if btns[0]=1 then race:=1 else
if btns[1]=1 then race:=2 else
if btns[2]=1 then race:=3 else
race:=0;
for x:=0 to 8 do
btns[x]:=0;
new(dlg4,init(@self,pchar('DIALOG_4')));
dlg4^.transferbuffer:=@btns;
application^.execdialog(dlg4);
if btns[0]=1 then educ:=1 else
if btns[1]=1 then educ:=2 else
if btns[2]=1 then educ:=3 else
if btns[3]=1 then educ:=4 else
if btns[4]=1 then educ:=5 else
if btns[5]=1 then educ:=6 else
educ:=0;
for x:=0 to 8 do
btns[x]:=0;
new(dlg5,init(@self,pchar('DIALOG_5')));
dlg5^.transferbuffer:=@btns;
application^.execdialog(dlg5);
if btns[0]=1 then work:=6 else
if btns[1]=1 then work:=5 else
if btns[2]=1 then work:=4 else
if btns[3]=1 then work:=3 else
if btns[4]=1 then work:=2 else
if btns[5]=1 then work:=1 else
work:=0;
for x:=0 to 8 do
btns[x]:=0;
new(dlg6,init(@self,pchar('DIALOG_6')));
dlg6^.transferbuffer:=@btns;
application^.execdialog(dlg6);
if btns[0]=1 then region:=1 else
if btns[1]=1 then region:=2 else
if btns[2]=1 then region:=3 else
if btns[3]=1 then region:=4 else
region:=0;
for x:=0 to 8 do
btns[x]:=0;
new(dlg7,init(@self,pchar('DIALOG_7')));
dlg7^.transferbuffer:=@btns;
application^.execdialog(dlg7);
if btns[0]=1 then res:=2 else
if btns[1]=1 then res:=1 else
res:=0;
for x:=0 to 8 do
btns[x]:=0;
fsiq:=0;
psiq:=0;
vsiq:=0;
fsiq:=54.96+(0.47*age) + (1.76*gender) + (4.71*race) + (5.02*educ) + ( 1.89*work) +
(0.59*region);
vsiq:=54.23+(0.49*age) + (1.92*gender) + (4.24*race) + (5.25*educ) + ( 1.89*work) +
(1.24*res);
psiq:=61.58+(0.31*age) + (1.09*gender) + (4.95*race) + (3.75*educ) + ( 1.54*work) +
(0.82*region);
if (age>0) and (gender>0) and (race>0) and (educ>0) and (work>0) and
(region>0) and (res>0) then
begin
new(dlg99,init(@self,pchar('DIALOG_99')));
application^.execdialog(dlg99);
end
else
begin
new(dlg100,init(@self,pchar('warning')));
application^.execdialog(dlg100);
end;
end;
procedure tmainwin.item2 (var msg:tmessage);
begin
if
sfxmsgbox (hwindow,'Are you sure you want to END?', 'Terminate Program?',mb_iconquestion
or mb_gostop,0)=id_go
then
closewindow
else
end;
procedure tmainwin.item4 (var msg:tmessage);
var
buffer:array[0..30]of char;
dialog:pinfodlg;
begin
dialog:=new(pinfodlg,init(@self,'aboutdlg',buffer));
application^.execdialog(dialog);
end;
procedure tmainwin.help (var msg:tmessage);
begin
winhelp (hwindow,'barona.HLP',help_index,0);
end;
{******************* MAIN WINDOW INITS ****************************}
constructor tmainwin.init (aparent:pwindowsobject; atitle:pchar);
begin
tsfxwindow.init (aparent,atitle);
cmhelp:=false;
attr.menu:=loadmenu(hinstance, 'menu_1');
end;
procedure tmenuapp.initmainwindow;
begin
mainwindow:=new(pmainwin, init (nil, 'BARONA REGRESSION ESTIMATED IQ VERSION 1.1'));
end;
{******************* MAIN PROGRAM ****************************}
var menuapp:tmenuapp;
begin
menuapp.init('menu demo');
menuapp.run;
menuapp.done;
end.